Dla zapewnienia powtarzalności wyników przy każdym uruchomieniu raportu dla tych samych danych, ustawiono ziarno dla generatora liczb pseudolosowych.
set.seed(23)
Raport został stworzony przy wykorzystaniu następujących bibliotek.
library(dplyr)
library(ggplot2)
library(tidyr)
library(tibble)
library(plotly)
library(gganimate)
colors <- read.csv("dataset/colors.csv")
parts_cat <- read.csv("dataset/part_categories.csv")
elements <- read.csv("dataset/elements.csv")
parts <- read.csv("dataset/parts.csv")
inv_parts <- read.csv("dataset/inventory_parts.csv")
figs <- read.csv("dataset/minifigs.csv")
inv_figs <- read.csv("dataset/inventory_minifigs.csv")
themes <- read.csv("dataset/themes.csv")
sets <- read.csv("dataset/sets.csv")
inv_sets <- read.csv("dataset/inventory_sets.csv")
inventories <- read.csv("dataset/inventories.csv")
Ta sekcja poświęcona jest przetworzeniu brakujących wartości oraz transformacji wykorzystanych zbiorów danych.
Pierwsza i bardzo ważna część badanego zbioru danych. Zawierają się tutaj informacje o zestawach Lego, takie jak rok wydania oraz ilość części w zestawie, ale też lata w jakich dany zestaw zadebiutował na rynku.
themes <- setNames(themes, c("theme_id", "theme_name", "parent_id"))
colnames(sets)[colnames(sets) == "name"] <- "set_name"
colnames(sets)[colnames(sets) == "num_parts"] <- "set_num_parts"
colnames(inv_sets)[colnames(inv_sets) == "quantity"] <- "set_qty"
sets_with_themes <- themes %>%
merge(sets, by = "theme_id") %>%
select(-c("theme_id","img_url","parent_id"))
Na wykresach można zaobserwować pewien trend. Wskazuje on na to, że wraz z upływem czasu powstaje coraz więcej zestawów Lego. Dodatkowo są one coraz większe i bardziej rozbudowane, na co wskazuje rosnąca liczba części.
unique_theme_data <- sets_with_themes %>%
group_by(year) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(unique_theme = n_distinct(theme_name, na.rm = TRUE))
ggplot(unique_theme_data , aes(x = year, y = unique_theme)) +
geom_line(aes(y = unique_theme, color = "Unikalne tematyki zestawów")) +
labs(x = "Rok", y = "Liczba tematyk", colour = "Legenda") +
scale_color_manual(values=c("#fc8d62")) +
theme_bw()
mean_nparts_data <- sets_with_themes %>%
group_by(year) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(sets_mean_nparts = mean(set_num_parts, na.rm = TRUE), sets_count = n())
ggplot(mean_nparts_data , aes(x = year, y = sets_mean_nparts)) +
ggtitle("Średnia liczba części w zestawach w latach 1980-2023") +
geom_bar(stat="identity", fill = "#fc8d62") +
labs(x = "Rok", y = "Liczba części") +
theme_bw()
knitr::kable(summary(sets_with_themes), caption = "Podstawowe statystyki - zestawy Lego")
| theme_name | set_num | set_name | year | set_num_parts | |
|---|---|---|---|---|---|
| Length:21880 | Length:21880 | Length:21880 | Min. :1949 | Min. : 0.0 | |
| Class :character | Class :character | Class :character | 1st Qu.:2001 | 1st Qu.: 3.0 | |
| Mode :character | Mode :character | Mode :character | Median :2012 | Median : 31.0 | |
| Mean :2008 | Mean : 161.4 | ||||
| 3rd Qu.:2018 | 3rd Qu.: 139.0 | ||||
| Max. :2024 | Max. :11695.0 |
Kolejna część badanego zbioru danych. Możemy znaleźć tutaj informacje o figurkach m.in. z czego się one składają.
colnames(figs)[colnames(figs) == "name"] <- "fig_name"
colnames(figs)[colnames(figs) == "num_parts"] <- "fig_num_parts"
colnames(inv_figs)[colnames(inv_figs) == "quantity"] <- "fig_qty"
colnames(inventories)[colnames(inventories) == "id"] <- "inventory_id"
inventory_minifigures <- inv_figs %>%
merge(figs, by = "fig_num") %>%
merge(inventories, by = "inventory_id") %>%
merge(sets, by = "set_num") %>%
select(-c(1:2, 7:9, 11:13))
Jeśli chodzi o ilość wykorzystywanych w zestawach figurek, to możemy zauważyć, że z czasem wykorzystywane są one coraz częściej.
figures_number <- inventory_minifigures %>%
group_by(year) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(fig_count = n())
ggplot(figures_number , aes(x = year, y = fig_count)) +
geom_line(aes(y = fig_count, color = "Liczba figurek")) +
labs(x = "Rok", y = "Liczba figurek", colour = "Legenda") +
scale_color_manual(values=c("#fc8d62")) +
theme_bw()
knitr::kable(summary(inventory_minifigures), caption = "Podstawowe statystyki - figurki Lego")
| fig_num | fig_qty | fig_name | fig_num_parts | year | |
|---|---|---|---|---|---|
| Length:20858 | Min. : 1.000 | Length:20858 | Min. : 0.000 | Min. :1975 | |
| Class :character | 1st Qu.: 1.000 | Class :character | 1st Qu.: 4.000 | 1st Qu.:2006 | |
| Mode :character | Median : 1.000 | Mode :character | Median : 4.000 | Median :2014 | |
| Mean : 1.062 | Mean : 4.813 | Mean :2011 | |||
| 3rd Qu.: 1.000 | 3rd Qu.: 5.000 | 3rd Qu.:2019 | |||
| Max. :100.000 | Max. :143.000 | Max. :2023 |
Ostatania część badanego zestawu danych zawiera informacje na temat części Lego. Znajdują się tutaj szczegóły poszczególnych części: elementy z których się składają, kolory, materiał z którego zostały wykonane oraz kategoria do której przynależą.
colnames(parts)[colnames(parts) == "name"] <- "part_name"
colnames(parts_cat)[colnames(parts_cat) == "name"] <- "part_cat_name"
colnames(parts_cat)[colnames(parts_cat) == "id"] <- "part_cat_id"
colnames(colors)[colnames(colors) == "name"] <- "color_name"
colnames(colors)[colnames(colors) == "id"] <- "color_id"
colnames(inv_parts)[colnames(inv_parts) == "quantity"] <- "part_qty"
element_counts <- elements %>%
group_by(part_num, color_id) %>%
summarise(element_per_part_in_color = n())
inventory_parts <- inv_parts %>%
merge(parts, by = "part_num") %>%
merge(colors, by = "color_id") %>%
merge(parts_cat, by = "part_cat_id") %>%
merge(element_counts, by = c("part_num", "color_id")) %>%
merge(inventories, by = "inventory_id") %>%
merge(sets, by = "set_num") %>%
select(-c(1:2, 4, 7:8, 12, 16:17, 19:21))
W przypadku części Lego również można dostrzeć pewne trendy. Wykorzystywane elementy są coraz bardzie zróżnicowane, poprzez tworzenie części z nowych materiałów oraz w nowych kolorach. Warte wyróżnienia jest że złożoność części się nie zmieniła (na jedną część średnio przypada 1.5 elementu)
transparent_parts <- inventory_parts %>%
group_by(is_trans) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(trans_part_count = n())
ggplot(transparent_parts, aes(x=is_trans, y=trans_part_count, fill=is_trans)) +
geom_bar(stat="identity", position="dodge") +
scale_fill_manual(values = c("t" = "#66c2a5", "f" = "#fc8d62"), labels = c("TAK", "NIE")) +
scale_x_discrete(labels = c("t" = "TAK", "f" = "NIE")) +
labs(title = "Zestawienie kolorów (transparentność)", x = "Transparentność", y = "Liczba obserwacji", fill = "Legenda")
unique_data <- inventory_parts %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
group_by(year, part_material) %>%
summarise(count = n(), type = "Material") %>%
bind_rows(
inventory_parts %>%
group_by(year, color_name) %>%
summarise(count = n(), type = "Color") %>%
bind_rows(
inventory_parts %>%
group_by(year, part_cat_name) %>%
summarise(count = n(), type = "Category")
)
)
ggplot(unique_data, aes(x = year, y = count, fill = type)) +
geom_bar(stat = "identity", position = "dodge") +
facet_grid(type ~ ., scales = "free_y", labeller = labeller(type = c("Material" = "Materiały", "Color" = "Kolory", "Category" = "Kategorie"))) +
scale_fill_manual(values = c("Category" = "#66c2a5", "Color" = "#fc8d62", "Material" = "#8da0cb"), labels = c("Kategorie", "Kolory", "Materiały")) +
labs(x = "Rok", y = "Liczba obserwacji", fill = "Legenda") +
theme_bw()
elements_count <- inventory_parts %>%
group_by(year) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(el_in_part = mean(element_per_part_in_color, na.rm = TRUE))
ggplot(elements_count , aes(x = year, y = el_in_part)) +
geom_line(aes(color = "Średnia ilość elementów w częściach")) +
labs(x = "Rok", y = "Liczba elementów", colour = "Legenda") +
scale_color_manual(values=c("#fc8d62")) +
theme_bw()
knitr::kable(summary(inventory_parts), caption = "Podstawowe statystyki - części Lego")
| part_num | part_cat_id | part_qty | part_name | part_material | color_name | is_trans | part_cat_name | element_per_part_in_color | year | |
|---|---|---|---|---|---|---|---|---|---|---|
| Length:1040218 | Min. : 1.00 | Min. : 1.000 | Length:1040218 | Length:1040218 | Length:1040218 | Length:1040218 | Length:1040218 | Min. :1.000 | Min. :1954 | |
| Class :character | 1st Qu.:11.00 | 1st Qu.: 1.000 | Class :character | Class :character | Class :character | Class :character | Class :character | 1st Qu.:1.000 | 1st Qu.:2008 | |
| Mode :character | Median :15.00 | Median : 2.000 | Mode :character | Mode :character | Mode :character | Mode :character | Mode :character | Median :1.000 | Median :2016 | |
| Mean :21.73 | Mean : 3.566 | Mean :1.591 | Mean :2013 | |||||||
| 3rd Qu.:28.00 | 3rd Qu.: 4.000 | 3rd Qu.:2.000 | 3rd Qu.:2020 | |||||||
| Max. :68.00 | Max. :3064.000 | Max. :9.000 | Max. :2023 |
dataset <- unique_theme_data %>%
merge(mean_nparts_data) %>%
merge(figures_number) %>%
merge(transparent_parts) %>%
merge(elements_count)
knitr::kable(summary(dataset))
| year | unique_theme | sets_mean_nparts | sets_count | fig_count | is_trans | trans_part_count | el_in_part | |
|---|---|---|---|---|---|---|---|---|
| Min. :1980 | Min. :14.00 | Min. : 66.47 | Min. : 74.0 | Min. : 48.0 | Length:88 | Min. : 61982 | Min. :1.426 | |
| 1st Qu.:1991 | 1st Qu.:24.00 | 1st Qu.:102.28 | 1st Qu.: 157.5 | 1st Qu.: 135.2 | Class :character | 1st Qu.: 61982 | 1st Qu.:1.588 | |
| Median :2002 | Median :56.00 | Median :131.77 | Median : 420.0 | Median : 289.0 | Mode :character | Median :513352 | Median :1.610 | |
| Mean :2002 | Mean :53.66 | Mean :140.95 | Mean : 468.8 | Mean : 468.2 | Mean :513352 | Mean :1.598 | ||
| 3rd Qu.:2012 | 3rd Qu.:79.75 | 3rd Qu.:171.05 | 3rd Qu.: 729.5 | 3rd Qu.: 855.5 | 3rd Qu.:964721 | 3rd Qu.:1.638 | ||
| Max. :2023 | Max. :96.00 | Max. :307.83 | Max. :1149.0 | Max. :1301.0 | Max. :964721 | Max. :1.662 |
W tej sekcji przedstawiono jak na przestrzeni lat (1980-2023) zmieniały się trendy w Lego. Uwzględniono zmiany w złożoności zestawów (średniej wykorzystywanych w nich części) poprzez wielkość punktu, w porównaniu z ilością wykorzystywanych w zestawach figurek oraz liczby dostępnych zestawów.
Na podstawie wykresu możemy zauważyć, że największy przesko jeśli chodzi o zaawansowanie zestawów (ich ilośc i złożoność), przypada na okres około 2010 roku.
animation <- dataset %>%
select(year, sets_count, fig_count, sets_mean_nparts)
p <- ggplot(animation, aes(x=sets_count, y=fig_count, size = sets_mean_nparts)) +
geom_point(show.legend = FALSE, alpha = 0.8, color = "#fc8d62") +
labs(title = 'Rok: {frame_time}', x = "Liczba dostępnych zestawów", y = "Ilość wykorzystywanych figurek") +
transition_time(year)
animate(p, nframes = 225)
Na poniższym wykresie przedstawiona została wartość współczynnika korelacji Pearsona między parametrami atrybutów w zbiorze.
W tabeli przedstawiono wartości współczynnika korelacji dla poszczególnych par atrybutów.
| Wiersz | Kolumna | Współczynnik korelacji |
|---|---|---|
| fig_count | sets_count | 0.9675649 |
| unique_theme | year | 0.9640386 |
| sets_count | year | 0.9477051 |
| sets_count | unique_theme | 0.9447247 |
| fig_count | year | 0.9274481 |
| fig_count | unique_theme | 0.9067765 |
| sets_mean_nparts | year | 0.7868182 |
| fig_count | sets_mean_nparts | 0.7656128 |
| sets_count | sets_mean_nparts | 0.7039379 |
| sets_mean_nparts | unique_theme | 0.6696571 |
| el_in_part | unique_theme | 0.3051613 |
| el_in_part | year | 0.2539668 |
| el_in_part | sets_mean_nparts | -0.1348402 |
| el_in_part | sets_count | 0.1026486 |
| el_in_part | fig_count | 0.0265213 |
| sets_mean_nparts | trans_part_count | 0.0000000 |
| sets_count | trans_part_count | 0.0000000 |
| fig_count | trans_part_count | 0.0000000 |
| trans_part_count | year | 0.0000000 |
| trans_part_count | unique_theme | 0.0000000 |
| el_in_part | trans_part_count | 0.0000000 |
Wnioski wyciągnięte na podstawień obliczeń współczynnika korelacji:
W tej sekcji opisano sposób wykorzystania uczenia maszynowego, w celu próby przewidzenia dalszych cech zestawów Lego. W tym celu wykorzystano algorytm Random Forest z wykorzystaniem losowanie ze zwracaniem (powtórzonej metody krzyżowej jak nie ogarnę bootstrapingu).